home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d26 / sp12src.arc / MARKDOC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-28  |  2.4 KB  |  111 lines
  1. {$A+,B-,D-,E-,F-,G-,I+,L-,N-,O-,R-,S-,V+,X+}
  2. {$M 16384,0,655360}
  3. Program MarkDoc;
  4. { Document marker program - processes the -M+ output from SPELCHEK. }
  5. Uses Dos, Crt;
  6.  
  7. Const
  8.   WorkExt = '.$$$';
  9.   BakExt = '.BAK';
  10.   BufSize = 16384;
  11.   DefaultMark = '#';
  12.  
  13. Var
  14.   StdIn : Text;
  15.   InFile, WorkFile : File;
  16.   Mark : String;
  17.   DocOpen : Boolean;
  18.   InBuf : Array[1..BufSize] Of Char;
  19.  
  20. Procedure FlushToPosition(n : LongInt);
  21. Var
  22.   ReadLen : LongInt;
  23. Begin
  24.   While (FilePos(InFile) < n) And Not Eof(InFile) Do Begin
  25.     ReadLen := n - FilePos(InFile);
  26.     If ReadLen > BufSize Then ReadLen := BufSize;
  27.     BlockRead(InFile, InBuf, ReadLen);
  28.     BlockWrite(WorkFile, InBuf, ReadLen);
  29.   End;
  30. End;
  31.  
  32. Function FileExists(Name : PathStr) : Boolean;
  33. Var
  34.   f : File;
  35. Begin
  36.   {$I-}
  37.   Assign(f, Name);
  38.   Reset(f);
  39.   If IoResult = 0 Then Begin
  40.     FileExists := True;
  41.     Close(f);
  42.   End Else FileExists := False;
  43.   {$I+}
  44. End;
  45.  
  46. Procedure CloseDocument(Name : PathStr);
  47. Var
  48.   f : File;
  49.   d : DirStr;
  50.   n : NameStr;
  51.   e : ExtStr;
  52.   BakName : PathStr;
  53. Begin
  54.   FlushToPosition(FileSize(InFile));
  55.   Close(InFile);
  56.   Close(WorkFile);
  57.   DocOpen := False;
  58.   FSplit(Name, d, n, e);
  59.   BakName := d + n + BakExt;
  60.   If FileExists(BakName) Then Begin
  61.     Assign(f, BakName);
  62.     Erase(f);
  63.     WriteLn('Erased backup file ', BakName);
  64.   End;
  65.   Rename(InFile, BakName);
  66.   WriteLn('Original file saved in ', BakName);
  67.   Rename(WorkFile, Name);
  68.   WriteLn('Words marked in ', Name);
  69. End;
  70.  
  71. Procedure ReadStdIn;
  72. Var
  73.   num : LongInt;
  74.   p : PathStr;
  75.   d : DirStr;
  76.   n : NameStr;
  77.   e : ExtStr;
  78.   s : String;
  79.   OutName : PathStr;
  80. Begin
  81.   DocOpen := False;
  82.   Repeat
  83.     ReadLn(StdIn, num, s);
  84.     Delete(s, 1, 1);
  85.     If (num = 0) And (s <> '') Then Begin
  86.       If DocOpen Then CloseDocument(p);
  87.       p := s;
  88.       FSplit(p, d, n, e);
  89.       OutName := d + n + WorkExt;
  90.       Assign(InFile, s);
  91.       Reset(InFile, 1);
  92.       Assign(WorkFile, OutName);
  93.       ReWrite(WorkFile, 1);
  94.       DocOpen := True;
  95.     End Else Begin
  96.       FlushToPosition(Pred(num));
  97.       BlockWrite(WorkFile, Mark[1], Length(Mark));
  98.     End;
  99.   Until Eof(StdIn);
  100.   If DocOpen Then CloseDocument(p);
  101. End;
  102.  
  103. Begin
  104.   If ParamCount > 0 Then Mark := ParamStr(1) Else Mark := DefaultMark;
  105.   DocOpen := False;
  106.   Assign(StdIn, '');
  107.   Reset(StdIn);
  108.   ReadStdIn;
  109.   Close(StdIn);
  110.   WriteLn('Done!');
  111. End.